home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS081.dsk / INVERSE FIELD INPUT.bas < prev   
BASIC Source File  |  2012-02-16  |  3KB  |  103 lines
  1. 0 D$ =  CHR$(13) + CHR$(4): TEXT : HOME : PRINT D$"BLOAD INV.INPUT.INST"
  2. 2  VTAB 23: HTAB 6: INVERSE : PRINT " PRESS ANY KEY TO RUN PROGRAM ": NORMAL : GET A$
  3. 10  GOTO 200: REM  BRANCH TO TEST PROGRAM
  4. 19  REM 
  5. 20  REM  ***********************
  6. 21  REM  INVERSE FIELD INPUT
  7. 22  REM     SUBROUTINE
  8. 23  REM  ***********************
  9. 24  REM 
  10. 25  REM  IS$=INPUT STRING
  11. 27  REM  IC$=INPUT CHARACTER
  12. 29  REM   VT=VERT. TAB POSITION
  13. 30  REM      OF FIELD BEGINNING 
  14. 32  REM   HT=HORIZ. TAB POSITION
  15. 33  REM      OF FIELD BEGINNING 
  16. 35  REM   FL=FIELD LENGTH
  17. 37  REM   CP=CURSOR POSITION  
  18. 38  REM      IN FIELD
  19. 39  REM 
  20. 40  REM  LINE 50 IS BEGINNING
  21. 41  REM  OF SUBROUTINE
  22. 42  REM 
  23. 45  REM  SET INVERSE FIELD, SET
  24. 46  REM  INPUT STRING TO NULL,
  25. 47  REM  TAB TO BEGINNING OF
  26. 48  REM  FIELD, SET CP TO 1
  27. 50  INVERSE : VTAB VT: HTAB HT:IS$ = "":CP = 1
  28. 55  REM 
  29. 56  REM  READ CHARACTER, CHECK
  30. 57  REM  FOR ESC KEY
  31. 60  GET IC$: IF IC$ =  CHR$(27)  THEN  NORMAL : RETURN 
  32. 65  REM 
  33. 66  REM  CHECK FOR CARRIAGE RET.
  34. 70  IF IC$ =  CHR$(13)  THEN 130
  35. 75  REM 
  36. 76  REM  CHECK FOR BACK ARROW
  37. 80  IF IC$ =  CHR$(8)  THEN 150
  38. 85  REM 
  39. 86  REM  CHECK FOR CURSOR PAST 
  40. 87  REM  END OF FIELD
  41. 90  IF CP >FL  THEN  PRINT  CHR$(7);: GOTO 60
  42. 95  REM 
  43. 96  REM  CHECK FOR FORWARD ARROW
  44. 100  IF IC$ =  CHR$(21)  THEN 180
  45. 102  REM 
  46. 103  REM  DO NOT ALLOW INPUT OF
  47. 104  REM  CONTROL CHARACTERS
  48. 105  REM  (REMOVE THIS LINE TO
  49. 106  REM  ALLOW INPUT OF CONTROL
  50. 107  REM  CHARACTERS)
  51. 110  IF  ASC(IC$) <32  THEN  PRINT  CHR$(7);: GOTO 60
  52. 112  REM 
  53. 113  REM  ADD LATEST CHAR. TO
  54. 114  REM  STRING, PRINT CHAR.,
  55. 115  REM  INCREMENT CP, BRANCH
  56. 116  REM  BACK FOR NEXT CHAR.
  57. 120 IS$ = IS$ +IC$: PRINT IC$;:CP = CP +1: GOTO 60
  58. 125  REM 
  59. 126  REM  IF CARRIAGE RETURN,
  60. 127  REM  BLANK REST OF FIELD
  61. 128  REM  AND RETURN FROM
  62. 129  REM  SUBROUTINE
  63. 130  IF CP < = FL  THEN  FOR I = CP TO FL: PRINT " ";: NEXT 
  64. 140  NORMAL : RETURN 
  65. 143  REM 
  66. 144  REM  IF BACK ARROW, BACK-
  67. 145  REM  SPACE AND REMOVE LAST
  68. 146  REM  CHARACTER FROM STRING
  69. 150 CP = CP -1: IF CP = 0  THEN  PRINT  CHR$(7);: GOTO 50
  70. 160  PRINT IC$;: IF CP >1  THEN IS$ =  LEFT$(IS$,CP -1): GOTO 60
  71. 170  GOTO 50
  72. 172  REM 
  73. 173  REM  IF FORWARD ARROW, READ
  74. 174  REM  INVERSE CHARACTER AT
  75. 175  REM  CURSOR, CONVERT TO
  76. 176  REM  NORMAL CHARACTER, AND
  77. 177  REM  BRANCH TO LINE WHICH
  78. 178  REM  ADDS CHAR. TO STRING
  79. 180 AS =  PEEK( PEEK(40) +256 * PEEK(41) + PEEK(36)): IF AS <32  THEN IC$ =  CHR$(AS +64): GOTO 120
  80. 190 IC$ =  CHR$(AS): GOTO 120
  81. 192  REM 
  82. 193  REM  **********************
  83. 194  REM  TEST PROGRAM TO ILLUS-
  84. 195  REM  TRATE INVERSE FIELD
  85. 196  REM  INPUT SUBROUTINE
  86. 197  REM  **********************
  87. 198  REM 
  88. 200  HOME : VTAB 5
  89. 202  PRINT "INPUT THE REQUESTED INFORMATION"
  90. 204  PRINT "IN EACH FIELD.": PRINT 
  91. 206  PRINT "PRESS 'RETURN' AFTER EACH ENTRY."
  92. 210  VTAB 12: HTAB 11: PRINT "NAME: ";:FL = 20: GOSUB 500
  93. 220  VTAB 14: HTAB 2: PRINT "TELEPHONE NO.: ";:FL = 12: GOSUB 500
  94. 230 VT = 12:HT = 17:FL = 20: GOSUB 50:NA$ = IS$
  95. 240 VT = 14:HT = 17:FL = 12: GOSUB 50:PH$ = IS$
  96. 250  VTAB 18: HTAB 11: PRINT "NAME: "NA$
  97. 260  HTAB 2: PRINT "TELEPHONE NO.: "PH$
  98. 270  END 
  99. 500  INVERSE : FOR I = 1 TO FL: PRINT " ";: NEXT : NORMAL : RETURN 
  100. 600  REM 
  101. 610  REM  CHARLES L. HEARN
  102. 620  REM  7626 EAST 54TH PLACE
  103. 630  REM  TULSA, OKLAHOMA 74145